home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_pas / ootp_4 / mouse.pas < prev    next >
Pascal/Delphi Source File  |  1990-02-25  |  5KB  |  224 lines
  1. unit Mouse; { Listing 7-1 }
  2.  
  3. { this file should be saved and compiled as MOUSE.PAS }
  4.  
  5. interface
  6.  
  7. uses Dos;
  8.  
  9. procedure MouseCoords( var x,y : integer );
  10. function MouseLPressed : boolean;
  11. function MouseRPressed : boolean;
  12. function MouseLReleased : boolean;
  13. function MouseRReleased : boolean;
  14. function MouseInit : Boolean;
  15. procedure MouseShow;
  16. procedure MouseHide;
  17. procedure MouseSetPosition( x,y : integer );
  18. procedure MouseGetBPressInfo( var Status, Count : integer;
  19.                                        Button : integer );
  20. procedure MouseGetBRelInfo( var Status, Count : integer;
  21.                                        Button : integer );
  22. procedure MouseSetHMinMax( Min, Max : integer );
  23. procedure MouseSetVMinMax( Min, Max : integer );
  24. procedure MouseReset;
  25.  
  26.  
  27. implementation
  28. var
  29.    i : integer;
  30.  
  31. procedure MouseReset;
  32. var R : Registers;
  33. { AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : word }
  34. begin
  35.      R.AX := $21;
  36.      R.BX := 0;
  37.      R.CX := 0;
  38.      R.DX := 0;
  39.      R.SI := 0;
  40.      R.DI := 0;
  41.      R.DS := 0;
  42.      R.ES := 0;
  43.      Intr( $33, R );
  44. end;
  45.  
  46. function MouseLPressed : boolean ;
  47. var Status,Count : integer;
  48. begin
  49.      MouseGetBPressInfo( Status, Count, 0 );
  50.      if (Status AND $1)=$1 then
  51.         MouseLPressed := true
  52.      else
  53.         MouseLPressed := false;
  54. end;
  55.  
  56. function MouseLReleased : boolean ;
  57. var Status,Count : integer;
  58. begin
  59.      MouseGetBRelInfo( Status, Count, 0 );
  60.      if (((Status AND $1) = 0) AND (Count > 0)) then
  61.         MouseLReleased := true
  62.      else
  63.         MouseLReleased := false;
  64. end;
  65.  
  66. function MouseRPressed : boolean ;
  67. var Status,Count : integer;
  68. begin
  69.      MouseGetBPressInfo( Status, Count, 1 );
  70.      if (Status AND $2) = 2 then
  71.         MouseRPressed := true
  72.      else
  73.         MouseRPressed := false;
  74. end;
  75.  
  76. function MouseRReleased : boolean ;
  77. var Status,Count : integer;
  78. begin
  79.      MouseGetBRelInfo( Status, Count, 1 );
  80.      if (((Status AND $2) = 0) AND (Count > 0)) then
  81.         MouseRReleased := true
  82.      else
  83.         MouseRReleased := false;
  84. end;
  85.  
  86. function MouseInit : Boolean;
  87. var R : Registers;
  88. { AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : word }
  89. begin
  90.      R.AX := 0;
  91.      R.BX := 0;
  92.      R.CX := 0;
  93.      R.DX := 0;
  94.      R.SI := 0;
  95.      R.DI := 0;
  96.      R.DS := 0;
  97.      R.ES := 0;
  98.      Intr( $33, R );
  99.      if R.AX <> 0 then MouseInit := true else MouseInit := false;
  100. end;
  101.  
  102. procedure MouseShow;
  103. var R : Registers;
  104. begin
  105.      R.AX := 1;
  106.      R.BX := 0;
  107.      R.CX := 0;
  108.      R.DX := 0;
  109.      R.SI := 0;
  110.      R.DI := 0;
  111.      R.DS := 0;
  112.      R.ES := 0;
  113.      Intr( $33, R );
  114. end;
  115.  
  116. procedure MouseHide;
  117. var R : Registers;
  118. begin
  119.      R.AX := 2;
  120.      R.BX := 0;
  121.      R.CX := 0;
  122.      R.DX := 0;
  123.      R.SI := 0;
  124.      R.DI := 0;
  125.      R.DS := 0;
  126.      R.ES := 0;
  127.      Intr( $33, R );
  128. end;
  129.  
  130. procedure MouseCoords( var x,y : integer );
  131. var R : Registers;
  132. begin
  133.      R.AX := 3;
  134.      R.BX := 0;
  135.      R.CX := 0;
  136.      R.DX := 0;
  137.      R.SI := 0;
  138.      R.DI := 0;
  139.      R.DS := 0;
  140.      R.ES := 0;
  141.      Intr( $33, R );
  142.      x := R.CX;
  143.      y := R.DX;
  144. end;
  145.  
  146. procedure MouseSetPosition( x,y : integer );
  147. var R : Registers;
  148. begin
  149.      R.AX := 4;
  150.      R.BX := 0;
  151.      R.CX := x;
  152.      R.DX := y;
  153.      R.SI := 0;
  154.      R.DI := 0;
  155.      R.DS := 0;
  156.      R.ES := 0;
  157.      Intr( $33, R );
  158. end;
  159.  
  160. procedure MouseGetBPressInfo( var Status, Count : integer;
  161.                                        Button : integer );
  162. var R : Registers;
  163. begin
  164.      R.AX := 5;
  165.      R.BX := Button;
  166.      R.CX := 0;
  167.      R.DX := 0;
  168.      R.SI := 0;
  169.      R.DI := 0;
  170.      R.DS := 0;
  171.      R.ES := 0;
  172.      Intr( $33, R );
  173.      Status := R.AX;
  174.      Count := R.BX;
  175. end;
  176.  
  177. procedure MouseGetBRelInfo( var Status, Count : integer;
  178.                                        Button : integer );
  179. var R : Registers;
  180. begin
  181.      R.AX := 6;
  182.      R.BX := Button;
  183.      R.CX := 0;
  184.      R.DX := 0;
  185.      R.SI := 0;
  186.      R.DI := 0;
  187.      R.DS := 0;
  188.      R.ES := 0;
  189.      Intr( $33, R );
  190.      Status := R.AX;
  191.      Count := R.BX;
  192. end;
  193.  
  194.  
  195. procedure MouseSetHMinMax( Min, Max : integer );
  196. var R : Registers;
  197. begin
  198.      R.AX := 7;
  199.      R.BX := 0;
  200.      R.CX := Min;
  201.      R.DX := Max;
  202.      R.SI := 0;
  203.      R.DI := 0;
  204.      R.DS := 0;
  205.      R.ES := 0;
  206.      Intr( $33, R );
  207. end;
  208.  
  209. procedure MouseSetVMinMax( Min, Max : integer );
  210. var R : Registers;
  211. begin
  212.      R.AX := 8;
  213.      R.BX := 0;
  214.      R.CX := Min;
  215.      R.DX := Max;
  216.      R.SI := 0;
  217.      R.DI := 0;
  218.      R.DS := 0;
  219.      R.ES := 0;
  220.      Intr( $33, R );
  221. end;
  222.  
  223. end.
  224.